The following objects are masked from 'package:base':
as.Date, as.Date.numeric
Loading required package: TTR
Registered S3 method overwritten by 'quantmod':
method from
as.zoo.data.frame zoo
library(dplyr)
######################### Warning from 'xts' package ##########################
# #
# The dplyr lag() function breaks how base R's lag() function is supposed to #
# work, which breaks lag(my_xts). Calls to lag(my_xts) that you type or #
# source() into this session won't work correctly. #
# #
# Use stats::lag() to make sure you're not using dplyr::lag(), or you can add #
# conflictRules('dplyr', exclude = 'lag') to your .Rprofile to stop #
# dplyr from breaking base R's lag() function. #
# #
# Code in packages is not affected. It's protected by R's namespace mechanism #
# Set `options(xts.warn_dplyr_breaks_lag = FALSE)` to suppress this warning. #
# #
###############################################################################
Attaching package: 'dplyr'
The following objects are masked from 'package:xts':
first, last
The following objects are masked from 'package:stats':
filter, lag
The following objects are masked from 'package:base':
intersect, setdiff, setequal, union
library(plotly)
Loading required package: ggplot2
Attaching package: 'plotly'
The following object is masked from 'package:ggplot2':
last_plot
The following object is masked from 'package:stats':
filter
The following object is masked from 'package:graphics':
layout
# Define current yearcurrent_year <-2025# 1. Get Daily Datadf_hist_xts <-getSymbols("^IXIC", from ="2008-01-01", to ="2025-12-31",src ="yahoo", auto.assign =FALSE)# --- STEP A: Calculate the "True" Start Price for each Year ---# We need the close of the FIRST trading day to calculate accurate YTDyear_start_endpoints <-endpoints(df_hist_xts, on ="years")# The 'endpoints' function returns the LAST index of the period. # To get the FIRST index of the year, we take the previous year's end + 1.# (We handle the first year manually or just use a grouping trick)df_daily <-data.frame(Date =index(df_hist_xts), coredata(df_hist_xts)) %>%mutate(Year =as.numeric(format(Date, "%Y")))# Group by Year and take the first available Close pricedf_start_prices <- df_daily %>%group_by(Year) %>%summarise(Start_Price =first(`IXIC.Adjusted`))# --- STEP B: Natural Weeks (1 to 52) ---weekly_idx <-endpoints(df_hist_xts, on ="weeks")df_weekly <- df_hist_xts[weekly_idx, ]df_weekly <-data.frame(Date =index(df_weekly), coredata(df_weekly)) %>%mutate(Year =as.numeric(format(Date, "%Y")),Week =as.numeric(format(Date, "%V")) # ISO Week ) %>%# Filter for standard weeks only. # We exclude "Week 53" here because we will manually create the perfect one later.# We also exclude the "Week 1" glitch where Dec 31 is labeled as Week 1.filter(Week <=52, !(format(Date, "%m") =="12"& Week ==1))# --- STEP C: The "Special" Week 53 (Year End) ---yearly_idx <-endpoints(df_hist_xts, on ="years")df_yearend <- df_hist_xts[yearly_idx, ]df_yearend <-data.frame(Date =index(df_yearend), coredata(df_yearend)) %>%mutate(Year =as.numeric(format(Date, "%Y")),Week =53# Hard-code this as the final bucket )# --- STEP D: Combine and Calculate ---# Combine the natural weeks with the special year-end weekdf_combined <-bind_rows(df_weekly, df_yearend) %>%arrange(Year, Week)# Join with the Start Prices and calculate % Changedf_plot <-left_join(df_combined, df_start_prices, by ="Year") %>%mutate(change_from_year_start = ((`IXIC.Adjusted`/ Start_Price) -1) *100 )# Split into historical and currentdf_hist_plain <- df_plot %>%filter(Year < current_year)df_curr_year <- df_plot %>%filter(Year == current_year)# Calculate Averagedf_avg <- df_hist_plain %>%group_by(Week) %>%summarise(avg_change =mean(change_from_year_start, na.rm =TRUE))# --- STEP E: Plotting ---p <-plot_ly()# Historical Yearsp <-add_trace(p, data = df_hist_plain,x =~Week, y =~change_from_year_start,type ='scatter', mode ='lines', split =~Year, line =list(color ='grey', width =1),opacity =0.3,hoverinfo ="text",text =~paste("Year:", Year, "<br>Week:", Week, "<br>Change:", round(change_from_year_start, 1),"%"),showlegend =FALSE)# Current Yearif(nrow(df_curr_year) >0) { p <-add_trace(p, data = df_curr_year,x =~Week, y =~change_from_year_start,type ='scatter', mode ='lines',line =list(color ='#336699', width =3),name =as.character(current_year),hoverinfo ="text",text =~paste("Year:", Year, "<br>Week:", Week, "<br>Change:", round(change_from_year_start, 1),"%"))}# Average Linep <-add_trace(p, data = df_avg,x =~Week, y =~avg_change,type ='scatter', mode ='lines',line =list(color ='darkred', width =2, dash ='dot'),name ="Avg Return",hoverinfo ="text",text =~paste("Average", "<br>Week:", Week, "<br>Change:", round(avg_change, 1),"%"))# Layoutp <- p %>%layout(xaxis =list(title ="Week (53 = Year End)",range =c(0.5, 53.5),showgrid =FALSE,tickvals =c(1, 10, 20, 30, 40, 50, 53),ticktext =c("1", "10", "20", "30", "40", "50", "End") ),yaxis =list(title ="% Change", showgrid =TRUE, gridcolor ="#e5e5e5"),showlegend =TRUE,legend =list(orientation ="h", y =1.1),plot_bgcolor ="white") %>%config(displayModeBar =FALSE)p